unit rTrack;

interface

uses
   System.SysUtils,
   System.Classes,
   GLS.Scene, GLS.VectorGeometry, GLS.Spline,
   rutils, Winapi.OpenGL, GLS.Utils, GLS.Texture, GLS.Objects,
   GLS.RenderContextInfo, GLS.OpenGLTokens;

type
    TrRoad = record
        matname: String;
        YOffset,
        width,
        Detail: double;
    end;

    TrNode = class
    public
        cube: TGLCube;
        Road: TrRoad;
        BorderSize,banking:single;
        constructor create;
        destructor destroy; override;
        procedure assign(node: TrNode);
        procedure WriteToStringList(var sl: TStringlist);
        procedure ReadFromStringList(sl: TStringlist; var index: Integer);
    end;

    TrTrack = class(TGLBaseSceneObject)
    private
        fcount: Integer;
        procedure SetSize(size: Integer);
    protected
        Data: array of TrNode;
        function GetNode(Index: Integer): TrNode;
        procedure SetNode(Index: Integer; node: TrNode);
    public
        Selected: TrNode;
        NodesVisible, LinesVisible: Boolean;
        LineWidth, Divisions: Integer;
        NodeSize: Double;
        LineColor, NodeColor, SelectedColor, StartColor, EndColor: TAffinevector;
        Closed: Boolean;
        
        constructor create(aowner:TComponent);override;
        destructor destroy; override;
        function IndexOf(node: TrNode): Integer;
        function Add(node: TrNode): Integer; overload;
        function Add: TrNode; overload;
        procedure Insert(node: TrNode; index: Integer); overload;
        function Insert(index: Integer): TrNode; overload;
        procedure Remove(index: Integer); //no memory freed
        procedure Delete(index: Integer); overload;
        procedure Delete(node: TrNode); overload;
        procedure Clear;
        procedure assign(track: TrTrack);
        procedure BuildList(var rci: TGLRenderContextInfo);override;
        procedure StructureChanged;override;
        function CreateCubicSpline(circuit: Boolean): TCubicSpline;
        procedure WriteToStringList(var sl: TStringlist);
        procedure ReadFromStringList(sl: TStringlist; var index: Integer);
        property Count: Integer read fCount;
        property Nodes[Index: Integer]: TrNode read GetNode write SetNode; default;
    end;


implementation

constructor TrNode.create;
begin
    inherited;
    cube := TGLCube.Create(NIL);
    cube.Tag := Integer(self);

    with road do
    begin
        matname := 'road';
        YOffset := 0;
        width := 1;
        Detail := 100;
    end;
    Bordersize:=3;
    banking:=0;
end;

procedure TrNode.assign(node: TrNode);
begin
    cube.assign(node.cube);
    cube.Tag := Integer(self);

    with road do
    begin
        matname := node.road.matname;
        YOffset := node.road.YOffset;
        width := node.road.width;
        Detail := node.road.detail;
    end;
end;

destructor TrNode.destroy;
begin
    cube.free;
    inherited;
end;

procedure TrNode.WriteToStringList(var sl: TStringlist);
begin
    sl.Add('node');

    sl.Add(format('%.4f %.4f %.4f', [cube.position.x, cube.position.y, cube.position.z]));
    with road do
    begin
        sl.Add(format('%.4f %.4f %.4f %.4f %.4f', [YOffset, width, Detail,BorderSize,banking]));
        sl.add(matname);
    end;
    sl.Add('end');
end;

procedure TrNode.ReadFromStringList(sl: TStringlist; var index: Integer);
var
    node: Trnode;
    ll: TStringList;
    procedure nextline;
    begin
        index := index + 1;
        parseline(sl[index], ll);
    end;
begin
    ll := TStringlist.create;
    nextline;

    cube.position.asaffinevector := affinevectormake(strtofloatdef(ll[0]), strtofloatdef(ll[1]), strtofloatdef(ll[2]));
    nextline;
    with road do
    begin
        YOffset := strtofloatdef(ll[0]);
        width := strtofloatdef(ll[1]);
        detail := strtofloatdef(ll[2]);
        BorderSize := strtofloatdef(ll[3]);
        if ll.count>4 then
            banking := strtofloatdef(ll[4]);
        nextline;
        matname := ll[0];
        nextline;
    end;
    ll.free;
end;
/////////////////////////////////////////////////////////////



procedure TrTrack.StructureChanged;
begin
    inherited;
end;

function TrTrack.CreateCubicSpline(circuit: Boolean): TCubicSpline;
var
    i, extra: Integer;
    xa, ya, za: PFloatArray;
begin
    extra := 0;
    if Closed then
        extra := 2;

    GetMem(xa, SizeOf(TGLFloat) * (Count + extra));
    GetMem(ya, SizeOf(TGLFloat) * (Count + extra));
    GetMem(za, SizeOf(TGLFloat) * (Count + extra));


    for i := 0 to Count - 1 do
        with nodes[i] do
        begin
            xa[i] := cube.position.x;
            ya[i] := cube.position.y;
            za[i] := cube.position.z;
        end;

    if closed AND (count >= extra) then
        for i := 0 to extra - 1 do
            with nodes[i] do
            begin
                xa[count + i] := cube.position.x;
                ya[count + i] := cube.position.y;
                za[count + i] := cube.position.z;
            end;

    Result := TCubicSpline.Create(xa, ya, za, NIL, Count + extra);
    FreeMem(xa);
    FreeMem(ya);
    FreeMem(za);
end;

procedure TrTrack.BuildList(var rci: TGLRenderContextInfo);
var
    spline: TCubicSpline;
    x, y, z, f: Single;
    i: Integer;
    v: TAffinevector;
    splinecount, nodeindex: Integer;
begin
    inherited;
    glPushAttrib(GL_ENABLE_BIT OR GL_CURRENT_BIT OR GL_LINE_BIT OR GL_COLOR_BUFFER_BIT);
    glDisable(GL_LIGHTING);
    glDisable(GL_DEPTH_TEST);

    if linesvisible AND (count > 1) then
    begin
        glDisable(GL_LINE_SMOOTH);
        glLineWidth(LineWidth);

        spline := CreateCubicSpline(Closed);
        f := 1 / Divisions;
        glBegin(GL_LINE_STRIP);

        if closed then
            splinecount := (count) * Divisions
        else
            splinecount := (count - 1) * Divisions;

        for i := 0 to splinecount do
        begin
            nodeindex := i DIV Divisions;
            if selected = nodes[nodeindex] then
                glColor3fv(@SelectedColor)
            else
            if nodeindex = count - 1 then
                glColor3fv(@EndColor)
            else
            if nodeindex = 0 then
                glColor3fv(@StartColor)
            else
                glColor3fv(@lineColor);

            Spline.SplineXYZ(i * f, x, y, z);
            glVertex3f(x, y, z);
        end;
        glend;
        spline.Free;
    end;

    if nodesvisible then
        for i := 0 to Count - 1 do
        begin
            if selected = nodes[i] then
                glColor3fv(@SelectedColor)
            else
            if i = count - 1 then
                glColor3fv(@EndColor)
            else
            if i = 0 then
                glColor3fv(@StartColor)
            else
                glColor3fv(@NodeColor);
            v := nodes[i].cube.Position.AsAffineVector;
            nodes[i].cube.CubeWidth := nodesize;
            nodes[i].cube.CubeHeight := nodesize;
            nodes[i].cube.CubeDepth := nodesize;
            glpushmatrix;
            gltranslatef(v.X, v.Y, v.Z);
            nodes[i].cube.buildlist(rci);
            glpopmatrix;
        end;
    glpopAttrib;
end;

constructor TrTrack.create(aowner:TComponent);
begin
    inherited;
    ObjectStyle:=ObjectStyle+[osDirectDraw];
    NodesVisible := TRUE;
    LinesVisible := TRUE;
    LineWidth := 4;
    NodeSize := 0.1;
    Divisions := 10;
    LineColor := affinevectormake(0, 1, 0);
    NodeColor := affinevectormake(1, 0, 0);
    SelectedColor := affinevectormake(1, 1, 0);
    StartColor := affinevectormake(1, 0, 1);
    EndColor := affinevectormake(0, 1, 1);
    
    selected := NIL;
end;

destructor TrTrack.destroy;
begin
    clear;
    inherited;
end;

procedure TrTrack.SetSize(size: Integer);
begin
    reallocmem(pointer(Data), size * sizeof(pointer));
end;

function TrTrack.Add(node: TrNode): Integer;
begin
    result := fcount;
    inc(fcount);
    setsize(fCount);
    Data[fCount - 1] := node;
    structurechanged;
end;

function TrTrack.Add: TrNode;
begin
    inc(fcount);
    setsize(fCount);
    result := TrNode.create;
    Data[fCount - 1] := result;
    structurechanged;
end;

procedure TrTrack.Insert(node: TrNode; index: Integer);
var
    i: Integer;
begin
    // if (index < 0) OR (index >= fCount) then
    //     raise Exception.CreateFmt('Index (%d) outside range 1..%d', [index, fCount - 1]);

    inc(fcount);
    setsize(fCount);

    for i := fcount - 1 downto index + 1 do
        Data[i] := Data[i - 1];

    Data[index] := node;
    structurechanged;
end;

function TrTrack.Insert(index: Integer): TrNode;
var
    i: Integer;
begin
    if (index < 0) OR (index >= fCount) then
        index := fCount - 1;

    inc(fcount);
    setsize(fCount);

    for i := fcount - 1 downto index + 1 do
        Data[i] := Data[i - 1];
    result := TrNode.create;
    Data[index] := result;
    structurechanged;
end;

procedure TrTrack.Remove(index: Integer);
var
    i: Integer;
begin
    // if (index < 0) OR (index >= fCount) then
    //     raise Exception.CreateFmt('Index (%d) outside range 1..%d', [index, fCount - 1]);

    for i := index to fcount - 2 do
        Data[i] := Data[i + 1];

    dec(fcount);
    setsize(fCount);
    structurechanged;
end;

procedure TrTrack.Delete(index: Integer);
var
    node: TrNode;
begin
    node := nodes[index];
    remove(index);
    node.free;
end;

procedure TrTrack.Delete(node: TrNode);
var
    index: Integer;
begin
    index := indexof(node);
    if index > -1 then
    begin
        remove(index);
        node.free;
    end;
end;

procedure TrTrack.Clear;
begin
    while fcount > 0 do
        Delete(fcount - 1);
end;


function TrTrack.IndexOf(node: TrNode): Integer;
var
    i: Integer;
begin
    result := -1;
    for i := 0 to count - 1 do
        if data[i] = node then
        begin
            result := i;
            break;
        end;
end;

procedure TrTrack.assign(track: TrTrack);
var
    i: Integer;
begin
    clear;
    for i := 0 to track.count - 1 do
        add(track.nodes[i]);
end;

function TrTrack.GetNode(Index: Integer): TrNode;
begin
    //if (index < 0) OR (index >= fCount) then
    //    raise Exception.CreateFmt('Index (%d) outside range 1..%d', [index, fCount - 1]);

    Result := data[Index];
end;

procedure TrTrack.SetNode(Index: Integer; node: TrNode);
begin
    // if (index < 0) OR (index >= fCount) then
    //     raise Exception.CreateFmt('Index (%d) outside range 1..%d', [index, fCount - 1]);

    data[Index] := node;
end;


procedure TrTrack.WriteToStringList(var sl: TStringlist);
var
    i: Integer;
begin
    sl.Add('track');
    sl.Add(format('%d %d %.4f', [LineWidth, Divisions, NodeSize]));
    sl.Add(format('%.2f %.2f %.2f', [LineColor.X, LineColor.Y, LineColor.Z]));
    sl.Add(format('%.2f %.2f %.2f', [NodeColor.X, NodeColor.Y, NodeColor.Z]));
    sl.Add(format('%.2f %.2f %.2f', [SelectedColor.X, SelectedColor.Y, SelectedColor.Z]));
    sl.Add(format('%.2f %.2f %.2f', [StartColor.X, StartColor.Y, StartColor.Z]));
    sl.Add(format('%.2f %.2f %.2f', [EndColor.X, EndColor.Y, EndColor.Z]));

    if Closed then
        sl.Add('true')
    else
        sl.Add('false');
    for i := 0 to count - 1 do
        nodes[i].WriteToStringList(sl);
    sl.Add('end');
end;

procedure TrTrack.ReadFromStringList(sl: TStringlist; var index: Integer);
var
    node: Trnode;
    ll: TStringlist;
    procedure nextline;
    begin
        index := index + 1;
        parseline(sl[index], ll);
    end;
begin
    clear;
    ll := TStringlist.create;
    nextline;

    linewidth := strtoint(ll[0]);
    Divisions := strtoint(ll[1]);
    NodeSize := strtofloatdef(ll[2]);

    
    
    nextline;
    linecolor := affinevectormake(strtofloatdef(ll[0]), strtofloatdef(ll[1]), strtofloatdef(ll[2]));
    nextline;
    nodecolor := affinevectormake(strtofloatdef(ll[0]), strtofloatdef(ll[1]), strtofloatdef(ll[2]));
    nextline;
    selectedcolor := affinevectormake(strtofloatdef(ll[0]), strtofloatdef(ll[1]), strtofloatdef(ll[2]));
    nextline;
    startcolor := affinevectormake(strtofloatdef(ll[0]), strtofloatdef(ll[1]), strtofloatdef(ll[2]));
    nextline;
    endcolor := affinevectormake(strtofloatdef(ll[0]), strtofloatdef(ll[1]), strtofloatdef(ll[2]));
    nextline;
    if ll[0] = 'true' then
        closed := TRUE
    else
        closed := FALSE;
    nextline;

        while (ll[0] = 'node') AND (index < sl.count) do
        begin
            node := add;
            node.readfromstringlist(sl, index);
            nextline;
        end;


    ll.free;
end;
/////////////////////////////////////////////////////////////

end.

